home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / pcmagwin.zip / GROUPFIL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-25  |  8KB  |  303 lines
  1. {$R-}
  2. UNIT GroupFile;
  3. (**) INTERFACE (**)
  4. {$IFDEF VER70}
  5. {$Q-}
  6. USES Objects, 
  7. {$ELSE}
  8. USES WObjects, 
  9. {$ENDIF}
  10. WinTypes, WinProcs, Strings, GroupType;
  11. {$R GROUPFIL.RES}
  12. {$I GROUPFIL.INC}
  13.  
  14. TYPE
  15.   PGroupFile = ^TGroupFile;
  16.   TGroupFile = OBJECT(TObject)
  17.     {This object only implements methods to get group file info that
  18.      I consider IMPORTANT.  You can always create a descendant and
  19.      add methods to, for example, get the wBitsPerPixel field, or
  20.      *write* data back to the GRP file.}
  21.     F               : File; {Note that F is opened in the
  22.                        Constructor and not closed 'til the
  23.                        Destructor}
  24.     PGH             : PGroupHeader;
  25.     HdrSize, Status : Word;
  26.     TagDir, TagHot  : rgiItemType;
  27.     TagMin          : ARRAY[0..49] OF Boolean;
  28.     CONSTRUCTOR Init(PName : PChar);
  29.     DESTRUCTOR Done; Virtual;
  30.     FUNCTION CalcCkSum  : Word;
  31.     FUNCTION GetStatus  : Word;
  32.     FUNCTION GetStatStr(P : PChar; MaxLen : Word) : PChar;
  33.     PROCEDURE ClearStatus;
  34.     FUNCTION cIdOk      : Boolean;
  35.     FUNCTION fwCheckSum : Word;
  36.     FUNCTION fcbGroup   : Word;
  37.     FUNCTION fnCmdShow  : Word;
  38.     FUNCTION frcNormal  : PRect;
  39.     FUNCTION fptMin     : PPoint;
  40.     FUNCTION fcItems    : Word;
  41.     FUNCTION PCharFmOffset(Offset : Word; P : PChar; MaxLen :
  42.       Word) : PChar;
  43.     FUNCTION fpName(P : PChar; MaxLen : Word) : PChar;
  44.     FUNCTION GetNthItem(N : Word; VAR TID : TItemData) : Boolean;
  45.     FUNCTION GetItemTagMin(Item : Word) : Boolean;
  46.     FUNCTIOn GetItemTagDir(Item : Word; P : PChar; MaxLen : Word) :
  47.       Boolean;
  48.     FUNCTION GetItemTagHot(Item : Word; VAR HotKey : Word) : Boolean;
  49.     FUNCTION GetItemTagHotStr(Item : Word; P : PChar; MaxLen :
  50.       Word) : Boolean;
  51.   END;
  52.  
  53. (**) IMPLEMENTATION (**)
  54.  
  55.   CONSTRUCTOR TGroupFile.Init(PName : PChar);
  56.   VAR
  57.     dirPos, W : Word;
  58.     I         : Integer;
  59.     TID       : TItemData;
  60.     TTD       : TTagData;
  61.   BEGIN
  62.     Status := msg_Ok;
  63.     {First read and verify fixed-size portion of header}
  64.     HdrSize := SizeOf(TGroupHeader) - SizeOf(rgiItemType);
  65.     GetMem(PGH, HdrSize);
  66.     FillChar(PGH^, HdrSize, 0);
  67.     Assign(F, PName);
  68.     {$I-} Reset(F, 1); {$I+}
  69.     I := IOresult;
  70.     IF I <> 0 THEN
  71.       BEGIN
  72.         Status := msg_OpenFileFailed;
  73.         FillChar(PGH^, HdrSize, 0);
  74.         Exit;
  75.       END;
  76.     BlockRead(F, PGH^, HdrSize);
  77.     IF NOT cIdOk THEN 
  78.       BEGIN
  79.         Status := msg_NotGRPFile;
  80.         FillChar(PGH^, HdrSize, 0);
  81.         Exit;
  82.       END;
  83.     IF CalcCkSum <> 0 THEN
  84.       BEGIN
  85.         Status := msg_CheckSumBad;
  86.         Exit;
  87.       END;
  88.     W := PGH^.cItems;
  89.     FreeMem(PGH, HdrSize);
  90.       {Now calculate actual header size and re-read COMPLETE header}
  91.     HdrSize := SizeOf(TGroupHeader) - SizeOf(rgiItemType) + 2*W;
  92.     GetMem(PGH, HdrSize);
  93.     Seek(F, 0);
  94.     BlockRead(F, PGH^, HdrSize);
  95.       {Fill arrays with tag info for hotkey and dir tags}
  96.     FillChar(TagHot, SizeOf(TagHot), 0);
  97.     FillChar(TagDir, SizeOf(TagDir), 0);
  98.     FillChar(TagMin, SizeOf(TagMin), FALSE);
  99.     IF fcbGroup = FileSize(F) THEN Exit;
  100.     Seek(F, fcbGroup);
  101.     BlockRead(F, TTD, 6);
  102.       {First tag should have wID=$8000}
  103.     IF TTD.wID <> $8000 THEN
  104.       BEGIN
  105.         Status := msg_FirstTagBad;
  106.         Exit;
  107.       END;
  108.     BlockRead(F, TTD.rgbString, TTD.cb-6);
  109.     REPEAT
  110.       {Read fixed-size portion of tag, including actual size in cb}
  111.       BlockRead(F, TTD, 6);
  112.       IF TTD.wID <> $FFFF THEN
  113.         BEGIN
  114.           {read remainder of tag data}
  115.           DirPos := FilePos(F);
  116.           BlockRead(F, TTD.rgbString, TTD.cb-6);
  117.           CASE TTD.wID OF
  118.             $8101 : TagDir[TTD.wItem] := DirPos;
  119.             $8102 : TagHot[TTD.wItem] := TTD.rgbShortcut;
  120.             $8103 : TagMin[TTD.wItem] := TRUE;
  121.             ELSE
  122.               Status := msg_TagBad;
  123.               Exit;
  124.           END;
  125.         END;
  126.     UNTIL TTD.wID = $FFFF;
  127.   END;
  128.  
  129.   DESTRUCTOR TGroupFile.Done;
  130.   BEGIN
  131.     FreeMem(PGH, HdrSize);
  132.     {$I-} Close(F); {$I+}
  133.     IF IOresult <> 0 THEN {tough!};
  134.     TObject.Done;
  135.   END;
  136.  
  137.   FUNCTION TGroupFile.GetStatus  : Word;
  138.   BEGIN
  139.     GetStatus := Status;
  140.   END;
  141.  
  142.   FUNCTION TGroupFile.GetStatStr(P : PChar; MaxLen : Word) : PChar;
  143.   BEGIN
  144.     LoadString(hInstance, Status, P, MaxLen);
  145.     GetStatStr := P;
  146.   END;
  147.  
  148.   PROCEDURE TGroupFile.ClearStatus;
  149.   BEGIN
  150.     Status := msg_Ok;
  151.   END;
  152.  
  153.   FUNCTION TGroupFile.CalcCkSum : Word;
  154.     {if value of wCheckSum field of header is correct, this
  155.      function returns 0}
  156.   TYPE BuffType = ARRAY[0..32760] OF Word;
  157.   VAR
  158.     FB          : ^BuffType;
  159.     CSum, N, FS : Word;
  160.   BEGIN
  161.     FS := FileSize(F);
  162.     GetMem(FB, FS);
  163.     Seek(F, 0);
  164.     BlockRead(F, FB^, FS);
  165.     CSum := 0;
  166.     FOR N := 0 TO pred(FS DIV 2) DO Inc(CSum, FB^[N]);
  167.     CalcCkSum := cSum;
  168.     FreeMem(FB, FS);
  169.   END;
  170.  
  171.   FUNCTION TGroupFile.cIdOk : Boolean;
  172.   BEGIN
  173.     cIdOk := StrLComp(PGH^.cIdentifier, 'PMCC', 4) = 0;
  174.   END;
  175.  
  176.   FUNCTION TGroupFile.fwCheckSum : Word;
  177.   BEGIN
  178.     fwCheckSum := PGH^.wCheckSum;
  179.   END;
  180.  
  181.   FUNCTION TGroupFile.fcbGroup : Word;
  182.   BEGIN
  183.     fcbGroup := PGH^.cbGroup;
  184.   END;
  185.  
  186.   FUNCTION TGroupFile.fnCmdShow : Word;
  187.   BEGIN
  188.     fnCmdShow := PGH^.nCmdShow;
  189.   END;
  190.  
  191.   FUNCTION TGroupFile.frcNormal : PRect;
  192.   BEGIN
  193.     frcNormal := @PGH^.rcNormal;
  194.   END;
  195.  
  196.   FUNCTION TGroupFile.fptMin : PPoint;
  197.   BEGIN
  198.     fptMin := @PGH^.ptMin;
  199.   END;
  200.  
  201.   FUNCTION TGroupFile.fcItems : Word;
  202.   BEGIN
  203.     fcItems := PGH^.cItems;
  204.   END;
  205.  
  206.   FUNCTION TGroupFile.PCharFmOffset(Offset : Word; P : PChar;
  207.     MaxLen : Word) : PChar;
  208.       {Reads MaxLen bytes from the file F at the specified offset
  209.        into the PChar P; returns P}
  210.   VAR Actual : Word;
  211.   BEGIN
  212.     {$I-}
  213.     Seek(F, Offset);
  214.     BlockRead(F, P^, MaxLen, Actual);
  215.     {$I+}
  216.     IF IOresult <> 0 THEN
  217.       BEGIN
  218.         P[0] := #0;
  219.         Status := msg_ReadStrFailed;
  220.       END;
  221.     PCharFmoffset := P
  222.   END;
  223.  
  224.   FUNCTION TGroupFile.fPName(P : PChar; MaxLen : Word) : PChar;
  225.   BEGIN
  226.     fPName := PCharFmOffset(PGH^.pName, P, MaxLen);
  227.   END;
  228.  
  229.   FUNCTION TGroupFile.GetNthItem(N : Word; VAR TID : TItemData) :
  230.     Boolean;
  231.     {Valid for N from 0 to PGH^.cItems-1.  If Nth item exists,
  232.      reads it into TID and returns TRUE; else FALSE.}
  233.   BEGIN
  234.     IF PGH^.rgiItems[N] <> 0 THEN
  235.       BEGIN
  236.         GetNthItem := TRUE;
  237.         {$I-}
  238.         Seek(F, PGH^.rgiItems[N]);
  239.         BlockRead(F, TID, SizeOf(TID));
  240.         {$I+}
  241.         IF IOResult <> 0 THEN
  242.           BEGIN
  243.             GetNthItem := FALSE;
  244.             Status := msg_BadItem;
  245.           END;
  246.       END
  247.     ELSE GetNthItem := FALSE;
  248.   END;
  249.  
  250.   FUNCTION TGroupFile.GetItemTagMin(Item : Word) : Boolean;
  251.   BEGIN
  252.     GetItemTagMin := TagMin[Item];
  253.   END;
  254.  
  255.   FUNCTION TGroupFile.GetItemTagDir(Item : Word; P : PChar;
  256.     MaxLen : Word) : Boolean;
  257.     {If a directory tag for the item exists, returns TRUE and puts 
  258.      the directory into PChar P; else returns FALSE}
  259.   BEGIN
  260.     IF TagDir[Item] <> 0 THEN
  261.       BEGIN
  262.         GetItemTagDir := TRUE;
  263.         PCharFmOffset(TagDir[Item], P, MaxLen);
  264.       END
  265.     ELSE GetItemTagDir := FALSE;
  266.   END;
  267.  
  268.   FUNCTION TGroupFile.GetItemTagHot(Item : Word; VAR HotKey : Word) :
  269.     Boolean;
  270.     {If a hotkey for the item exists, returns TRUE and puts hotkey
  271.      value in the HotKey argument; else returns FALSE}
  272.   BEGIN
  273.     IF TagHot[Item] <> 0 THEN
  274.       BEGIN
  275.         GetItemTagHot := TRUE;
  276.         HotKey := TagHot[Item];
  277.       END
  278.     ELSE GetItemTagHot := FALSE;
  279.   END;
  280.  
  281.   FUNCTION TGroupFile.GetItemTagHotStr(Item : Word; P : PChar;
  282.     MaxLen : Word) : Boolean;
  283.     {If a hotkey for the item exists, returns TRUE and puts a string
  284.      describing the hotkey into PChar P; else returns FALSE}
  285.   VAR
  286.     HK : Word;
  287.     chBuff : ARRAY[0..1] OF Char;
  288.   BEGIN
  289.     IF GetItemTagHot(Item, HK) THEN
  290.       BEGIN
  291.         GetItemTagHotStr := TRUE;
  292.         P[0] := #0;
  293.         IF Hi(HK) AND 2 = 2 THEN StrLCat(P, 'Ctrl+', MaxLen);
  294.         IF Hi(HK) AND 1 = 1 THEN StrLCat(P, 'Shift+', MaxLen);
  295.         IF Hi(HK) AND 4 = 4 THEN StrLCat(P, 'Alt+', MaxLen);
  296.         chBuff[0] := Char(Lo(HK));
  297.         chBuff[1] := #0;
  298.         StrLCat(P, chBuff, MaxLen);
  299.       END
  300.     ELSE GetItemTagHotStr := FALSE;
  301.   END;
  302.  
  303. END.